home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / SLTPU70C / MODEM.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-21  |  9KB  |  378 lines
  1. {$F-} {$S-} {$A-}
  2.  
  3. Unit Modem;
  4.   { Searchlight BBS Modem Interface Unit }
  5.  
  6.   { Procedures and functions in this unit can be used by DOOR programs
  7.     to access Searchlight's serial port drivers directly. I/O, carrier
  8.     detect, disconnect, and buffer controls are included.         }
  9.  
  10.   { These procedures work only in conjunction with Searchlight 2.15C
  11.     and later versions. See MODEM.DOC for more information.       }
  12.  
  13. Interface
  14.   Uses DOS;
  15.  
  16. type RSbaud = (B110,B150,B300,B600,B1200,B2400,B4800,B9600,B19200,B38400,
  17.                b7200,b12000,b14400,b16800);
  18.      AnsiType = (GENERIC,PROCOMM,STANDARD);
  19.  
  20.      SLDataType = record         { Public Data Area }
  21.       PROGID: string[6];                { Program ID }
  22.       carrier: boolean;                 { carrier check enabled? }
  23.       writeprotect: boolean;            { disk write protection? }
  24.       aborttype: byte;                  { 0=no abort, 1=terminate, 2=reboot }
  25.  
  26.       rsact: boolean;                   { set if rs232 active }
  27.       ansi: boolean;                    { is user in ANSI mode? }
  28.       color: boolean;                   { does user have a color crt? }
  29.       directvid: boolean;               { system DirectVideo mode }
  30.  
  31.       curratt: byte;                    { current video attribute }
  32.       commtype: byte;                   { run parameter }
  33.       idletime: word;                   { idle limit (seconds) }
  34.       lastkey: boolean;                 { TRUE = last key from local kbd }
  35.  
  36.       OldVector: array[$00..$7F] of pointer;   { old user int vectors }
  37.       AnsiMode: AnsiType;               { user's ANSI mode }
  38.      end;
  39.  
  40.  
  41. Var DriverLoaded: boolean;             { Set if SLBBS drivers available }
  42.     SLData: ^SLDataType;               { Pointer to public data area }
  43.     AUXIn: text;                       { RS232 Input File }
  44.     AUXOut: text;                      { RS232 Output File }
  45.  
  46.  Function CarrierDetect: boolean;      { Check carrier status }
  47. Procedure Hangup;                      { Disconnect (hangup) }
  48.  Function RS232Avail: boolean;         { Check RS232 char available }
  49.  Function RS232In: char;               { Read RS232 char }
  50. Procedure RS232Out (c: char);          { Write RS232 char }
  51. Procedure PauseOutput;                 { Pause buffered output }
  52. Procedure RestartOutput;               { Restart output after pause }
  53. Procedure ClearInputBuffer;            { Clear input buffer }
  54. Procedure ClearOutputBuffer;           { Clear output buffer }
  55.  Function BufferEmpty: boolean;        { Check buffer empty condition }
  56.  
  57. Procedure WaitOut;                     { Wait for output buffer to clear }
  58.  
  59. Procedure RSinit (com: integer; speed: RSbaud; buffactor: integer; flow: boolean);
  60.   { Initialize RS232 port }
  61.  
  62. Procedure RSCleanup;
  63.   { Reset RS232 port }
  64.  
  65. Procedure ComToggle;
  66.   { Toggle BIOS I/O support on and off }
  67.  
  68.  
  69. { New functions added for Searchlight 3.0 }
  70.  
  71. Function RSVersion: byte;             { Serial unit revision number }
  72.  
  73. Procedure RS232StrOut (count,strseg,strofs: word);
  74.   { write string to output }
  75.  
  76.  
  77.  
  78. Implementation
  79.  
  80. Const RSInt = $7E;             { interrupt for modem functions }
  81.       SLBBSID = $736C;         { code for identifying SL interrupts }
  82.  
  83. Var regs: registers;           { registers for most operations }
  84.     rscom: integer;            { set to active com port via RSinit }
  85.     p,exitsave: pointer;
  86.  
  87.  
  88. { ----- Hardware Modem Controls ----- }
  89.  
  90. Function CarrierDetect: boolean;
  91.   { read carrier detect pin; true=carrier detected }
  92. Begin
  93.   if DriverLoaded then begin
  94.     regs.ax:=2;
  95.     Intr(RSInt,regs);
  96.     CarrierDetect:=(regs.bx=1);
  97.   end else CarrierDetect:=true;
  98. end;
  99.  
  100.  
  101. Procedure Hangup;
  102.   { disconnect from remote user (hang up) }
  103. Begin
  104.   if DriverLoaded then begin
  105.     SLData^.Aborttype:=0;   { Set abort type to 'none'. This is important. }
  106.     regs.ax:=3;
  107.     Intr(RSInt,regs);
  108.   end;
  109. end;
  110.  
  111.  
  112.  
  113. { ----- Modem I/O Functions ----- }
  114.  
  115. Function RS232Avail: boolean;
  116.   { test whether a character is available in the input buffer }
  117. Begin
  118.   if DriverLoaded then begin
  119.     regs.ax:=4;
  120.     Intr(RSInt,regs);
  121.     RS232Avail:=(regs.bx=1);
  122.   end else RS232Avail:=false;
  123. end;
  124.  
  125.  
  126. Function RS232In: char;
  127.   { read next character from input buffer }
  128. Begin
  129.   regs.ax:=5;
  130.   Intr(RSInt,regs);
  131.   RS232In:=char(lo(regs.bx));
  132. end;
  133.  
  134.  
  135. Procedure RS232Out (c: char);
  136.   { write character to output buffer }
  137. Begin
  138.   regs.ax:=6;
  139.   regs.bx:=byte(c);
  140.   Intr(RSInt,regs);
  141. end;
  142.  
  143.  
  144. Procedure PauseOutput;
  145.   { if output buffering is on, pauses buffered output }
  146. Begin
  147.   if DriverLoaded then begin
  148.     regs.ax:=7;
  149.     Intr(RSInt,regs);
  150.   end;
  151. end;
  152.  
  153.  
  154. Procedure RestartOutput;
  155.   { resume buffered output after pausing }
  156. Begin
  157.   if DriverLoaded then begin
  158.     regs.ax:=8;
  159.     Intr(RSInt,regs);
  160.   end;
  161. end;
  162.  
  163.  
  164. Procedure ClearInputBuffer;
  165.   { clears the input buffer }
  166. Begin
  167.   if DriverLoaded then begin
  168.     regs.ax:=9;
  169.     Intr(RSInt,regs);
  170.   end;
  171. end;
  172.  
  173.  
  174. Procedure ClearOutputBuffer;
  175.   { clears the output buffer }
  176. Begin
  177.   if DriverLoaded then begin
  178.     regs.ax:=10;
  179.     Intr(RSInt,regs);
  180.   end;
  181. end;
  182.  
  183.  
  184. Function BufferEmpty: boolean;
  185.   { check if output buffer is empty }
  186. Begin
  187.   if DriverLoaded then begin
  188.     regs.ax:=11;
  189.     Intr(RSInt,regs);
  190.     BufferEmpty:=(regs.bx=1);
  191.   end else BufferEmpty:=true;
  192. end;
  193.  
  194.  
  195. Procedure WaitOut;
  196.   { wait until output buffer is empty }
  197. Begin
  198.   if DriverLoaded then begin
  199.     regs.ax:=12;
  200.     Intr(RSInt,regs);
  201.   end;
  202. end;
  203.  
  204.  
  205.  
  206. { ----- File Handlers ----- }
  207.  
  208. {$F+}
  209. Function RsFlush (var f: textrec): integer;
  210. Begin
  211.   RsFlush:=0;
  212. end;
  213.  
  214. Function RsClose (var f: textrec): integer;
  215. Begin
  216.   f.mode:=fmClosed;
  217.   RsClose:=0;
  218. end;
  219.  
  220. Function RsInput (var f: textrec): integer;
  221. Begin
  222.   with f do begin
  223.     bufptr^[0]:=RS232In;
  224.     bufend:=1;
  225.     bufpos:=0;
  226.   end;
  227.   RsInput:=0;
  228. end;
  229.  
  230.  
  231. Function RsOutput (var f: textrec): integer;
  232. Begin
  233.   with f do begin
  234.     RS232Out(bufptr^[0]);
  235.     bufpos:=0;
  236.   end;
  237.   RsOutput:=0;
  238. end;
  239.  
  240.  
  241. Function RsOpen (var f: textrec): integer;
  242. Begin
  243.   if (f.mode=fmInput)
  244.     then f.InOutFunc:=@RsInput
  245.     else f.InOutFunc:=@RsOutput;
  246.   f.FlushFunc:=@RsFlush;
  247.   f.CloseFunc:=@RsClose;
  248.   RsOpen:=0;
  249. end;
  250.  
  251.  
  252. Procedure AssignAUX (var f: text);
  253. Begin
  254.   with Textrec(f) do
  255.   begin
  256.     mode:=fmClosed;
  257.     bufsize:=1;
  258.     bufptr:=@Buffer;
  259.     OpenFunc:=@RsOpen;
  260.     name[0]:=#0;
  261.   end;
  262. end;
  263.  
  264.  
  265.  
  266. { ----- RS232 Initialization & Cleanup Code ----- }
  267.  
  268. Procedure RSinit (com: integer; speed: RSbaud; buffactor: integer; flow: boolean);
  269.   { initialize port; required only if port not already active }
  270. Begin
  271.   if driverloaded then begin
  272.     RSCom:=com;        { save port number }
  273.     if (rscom<>0) then begin
  274.       regs.ax:=0;
  275.       regs.bx:=com;
  276.       regs.cx:=ord(speed);
  277.       regs.dx:=buffactor;
  278.       regs.si:=word(flow);
  279.       Intr(RSInt,regs);
  280.     end;
  281.   end else RSCom:=0;
  282. end;
  283.  
  284.  
  285. Procedure RSCleanup;
  286.   { un-initialize port. should be used only if RSinit was used. }
  287. Begin
  288.   if (rscom<>0) then begin
  289.     regs.ax:=1;
  290.     Intr(RSInt,regs);
  291.   end;
  292.   rscom:=0;
  293. end;
  294.  
  295.  
  296. { ----- Searchlight Control Functions ----- }
  297.  
  298. Function GetPublicPtr: Pointer;
  299.   { get pointer to the SLBBS public data area. Returns NIL if not available }
  300. var p: pointer;
  301. Begin
  302.   if driverloaded then begin
  303.     regs.ax:=$C7;
  304.     regs.cx:=$00;
  305.     Intr(RSInt,regs);
  306.     if (regs.cx=SLBBSID)
  307.       then GetPublicPtr:=Ptr(regs.ax,regs.bx)
  308.       else GetPublicPtr:=Nil;
  309.   end else GetPublicPtr:=Nil;
  310. end;
  311.  
  312.  
  313. Procedure ComToggle;
  314.   { toggle BIOS COM support on/off }
  315. var save: pointer;
  316. Begin
  317.   if SLData<>nil then        { make sure Searchlight is loaded }
  318.     if SLData^.rsact then begin
  319.       GetIntVec($10,save);                       { read address of INT $10 }
  320.       SetIntVec($10,SLData^.OldVector[$10]);     { restore saved address }
  321.       SLData^.OldVector[$10]:=save;              { store retrieved address }
  322.       GetIntVec($16,save);
  323.       SetIntVec($16,SLData^.OldVector[$16]);     { repeat for INT $16 }
  324.       SLData^.OldVector[$16]:=save;
  325.     end;
  326. end;
  327.  
  328.  
  329. {$F+}
  330. Procedure ModemExit;
  331.   { cleanup procedure }
  332. Begin
  333.   System.ExitProc:=Modem.ExitSave;
  334.   RSCleanup;
  335. end;
  336. {$F-}
  337.  
  338.  
  339. Function RSVersion: byte; Assembler;
  340.   { return version number of serial unit }
  341. Asm
  342.   mov bl,0    { Note: it is importan to load BL with 0 before making this
  343.                 function call. Since function 23 was not implemented prior
  344.                 to Searchlight 3.0, this assures that 0 will be returned
  345.                 as the version number for pre-3.0 versions. }
  346.   mov al,23
  347.   int RSInt
  348.   mov al,bl
  349. end;
  350.  
  351. Procedure RS232StrOut (count,strseg,strofs: word); Assembler;
  352.   { NOTE: This function is valid only if the Version is 2 or greater }
  353. Asm
  354.   mov bx,count
  355.   mov cx,strseg
  356.   mov dx,strofs
  357.   mov al,15
  358.   int RSInt
  359. end;
  360.  
  361.  
  362.  
  363. Begin   { ----- Unit Initialization ----- }
  364.  
  365.   GetIntVec($79,p);                     { check if slbbs driver available }
  366.   DriverLoaded:=(longint(p)=SLBBSID);
  367.   SLData:=GetPublicPtr;                 { get public data area pointer }
  368.  
  369.   rscom:=0;
  370.   AssignAux(AUXIn);    { prepare file oriented i/o functions }
  371.   AssignAux(AUXOut);
  372.   reset(AUXIn);
  373.   rewrite(AUXOut);
  374.  
  375.   Modem.Exitsave:=System.Exitproc;     { install cleanup procedure }
  376.   System.Exitproc:=@ModemExit;
  377.  
  378. end.